
--- Pretty printing with the help of the 'Global' state

module frege.compiler.common.AnnotateG where

import frege.Prelude except(break, <+>)
-- import Data.List as DL(intersperse)
import frege.lib.PP  except (line)

-- import  Compiler.enums.RFlag(RState)
import  Compiler.types.Packs
import  Compiler.types.QNames
import  Compiler.types.External

import  Compiler.common.Annotate

import  Compiler.types.Global

notNil NONE = false
notNil _    = true

--- things that can be pretty printed when we have a 'Global'
class AnnoG a where
    annoG       ∷ Global →  a  → DOCUMENT
    annoListG   ∷ Global → [a] → DOCUMENT 
    annoSomeG   ∷ Global → String → String → String → [a] → DOCUMENT
    --- annotate a list of things using given separators
    annoSomeG g left _     right []     = text (left++right)
    annoSomeG g left comma right xs     = bracket left (sep comma items) right
        where items = filter notNil (map (annoG g) xs)
    annoListG g = annoSomeG g "{"  ","  "}"

--- wrapper for types that need no 'Global'
newtype GA a = GA a

instance Anno a => AnnoG (GA a) where
    annoG g (GA a) = anno a

--- return the top level name for annotations with a dot
metaName :: Global -> String
metaName g = abbreviate g "frege.runtime.Meta"

--- > metaFor "Foo" = "@Meta.Foo"
metaFor g foo = "@" ++ metaName g ++ "." ++ foo 

--- create a typical annotation
meta g kind vals = text (metaFor g kind) <> bracket "(" (sep ","  (map val fvals)) ")"
    where
        val (s, d) = text s <> text "=" <> d
        fvals = filter noNil vals
        noNil (_, PP.NONE) = false
        noNil _ = true

instance AnnoG QName where
    annoG g (TName p b) = meta g "QName" [
        ("kind", lit 0),
        ("pack", if p == oldPrelude then PP.nil else lit (Pack.raw p)),
        ("base", lit b)]
    annoG g (VName p b) = meta g "QName" [
        ("pack", if p == oldPrelude then PP.nil else lit (Pack.raw p)),
        ("base", lit b)]
    annoG g (MName (TName p b) m) = meta g "QName" [
        ("kind", lit 2),
        ("pack", if p == oldPrelude then PP.nil else lit (Pack.raw p)),
        ("base", lit b),
        ("member", lit m)]
    annoG g _ = error "QName.anno: unsupported QName"

instance AnnoG TauA where
    annoG g (TauA {kind,tcon,suba,subb,tvar}) = case kind of
        0  → meta g "Tau" [("kind", anno 0), ("suba", suba.anno), ("subb", subb.anno)]
        1  → meta g "Tau" [("kind", anno 1), ("suba", suba.anno), ("subb", subb.anno)]
        2  → meta g "Tau" [("kind", anno 2), ("suba", suba.anno), ("tcon", annoListG g (listFromMaybe tcon))]
        8  → meta g "Tau" [("kind", anno 8), ("suba", suba.anno), ("subb", subb.anno)]
        9  → meta g "Tau" [("kind", anno 9)]
        10 → meta g "Tau" [("kind", anno 10)]
        11 → meta g "Tau" [("kind", anno 11), ("suba", suba.anno)]
        -- default 3 (TVar)
        _  → meta g "Tau" [("suba", suba.anno), ("tvar", tvar.anno)]



instance AnnoG SigmaA where
    annoG g (SigmaA {bound,kinds,rho})
        | null bound = meta g "Sigma" [
            ("rho",   rho.anno)]
        | otherwise  = meta g "Sigma" [
            ("bound", bound.anno),
            ("kinds", kinds.anno),
            ("rho",   rho.anno)]


instance AnnoG RhoA where
    annoG g (RhoA {rhofun=true,cont,sigma,rhotau})
        | null cont = meta g "Rho" [
                        ("sigma",  sigma.anno),
                        ("rhotau", rhotau.anno)]
        | otherwise = meta g "Rho" [
                        ("cont",   annoListG g cont),
                        ("sigma",  sigma.anno),
                        ("rhotau", rhotau.anno)]
    annoG g (RhoA {rhofun=false,cont,sigma,rhotau})
        | null cont = meta g "Rho" [
                        ("rhofun", false.anno),
                        ("rhotau", rhotau.anno)]
        | otherwise = meta g "Rho" [
                        ("rhofun", false.anno),
                        ("cont",   annoListG g cont),
                        ("rhotau", rhotau.anno)]


instance AnnoG ContextA where
    annoG g (CtxA {clas,tau}) = meta g "Context" [
        ("clas", annoG g clas),
        ("tau",  tau.anno)]


instance AnnoG ExprA where
    annoG g (ExprA {xkind,name,lkind,varval,alts,subx1,subx2,subx3}) = meta g "Expr" [
        ("xkind",  if xkind  == defEA.xkind  then PP.nil else xkind.anno),
        ("name",   if name   == defEA.name   then PP.nil else annoListG g name.toList),
        ("lkind",  if lkind  == defEA.lkind  then PP.nil else lkind.anno),
        ("varval", if varval == defEA.varval then PP.nil else annoMbString varval),
        ("alts",   if alts   == defEA.alts   then PP.nil else alts.anno),
        ("subx1",  if subx1  == defEA.subx1  then PP.nil else subx1.anno),
        ("subx2",  if subx2  == defEA.subx2  then PP.nil else subx2.anno),
        ("subx3",  if subx3  == defEA.subx3  then PP.nil else subx3.anno),
        ]



--data AOP = AOP String Int Int
--
--instance AnnoG AOP where
--    annoG g (AOP s i j) = meta g "Operator" [("name", lit s), ("kind", lit i), ("prec", lit j)]
